COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	% ADDPROP INTERSECT UNION INIT_QM %
C00004 00003	% READ_BOOK SHOW SHOW0 GET_INP TFDM %
C00006 00004	% FDM COMBIN FDM1 FIND DIG MAKE %
C00010 00005	% GET_TIME TIMEP ASSUME %
C00011 00006	% BEFORE CONCURRENT %
C00014 00007	% DURATION INVOLVE KING START STOP %
C00016 00008	% TIMEX WAR YEAR %
C00019 ENDMK
C⊗;
% ADDPROP INTERSECT UNION INIT_QM %

BEGIN

SPECIAL TEMP, QM, ABBREV, TRACING;

EXPR ADDPROP(ATM, VAL, PROP);
	IF NUMBERP(ATM) OR ATM EQ QM THEN WARN("Putting properties on numbers")
	ELSE PUTPROP(ATM, VAL CONS GET(ATM, PROP), PROP);

EXPR INTERSECT(X, Y);
	IF ¬X THEN NIL
	ELSE IF X EQ QM THEN Y
	ELSE IF ATOM Y THEN INTERSECT(Y, X)
	ELSE IF CAR X MEMQ Y THEN CAR X CONS INTERSECT(CDR X, Y)
	ELSE INTERSECT(CDR X, Y);

% Should be used instead of COLLECT some places. %

EXPR UNION(X, Y);
	IF ¬X THEN Y
	ELSE IF X EQ QM THEN QM
	ELSE IF ATOM Y THEN UNION(Y, X)
	ELSE IF CAR X MEMQ Y THEN UNION(CDR X, Y)
	ELSE CAR X CONS UNION(CDR X, Y);

% Conveniences for dealing with "?" and abbreviations %

EXPR INIT_QM(QUES);
	BEGIN
	QM ← QUES;
	PUTPROP(QM, <QM, QM, QM, QM, QM>, 'IDEA);
	FOR NEW POS IN '(P1 P2 P3 P4 P5) DO PUTPROP(QM, QM, POS);
	ABBREV ← NIL;
	TRACING ← T;
	END;
% READ_BOOK SHOW SHOW0 GET_INP TFDM %

EXPR READ_BOOK(FILE);
	BEGIN
	NEW LINE;
	TRACING ← NIL;
	EVAL <'INPUT, '(390 RCP), FILE>;
	INC(T, NIL);
	WHILE (LINE ← READ()) DO
		IF ATOM(LINE) THEN ABBREV ← LINE
		ELSE FDM(LINE, 'M) ALSO ABBREV ← NIL;
	INC(NIL, T);
	END;

EXPR SHOW(IDEA);
	SHOW0(IDEA, 0);

EXPR SHOW0(IDEA, INDENT);
	BEGIN
	NEW I;
	I ← 0;
	WHILE (I ← I+1) ≤ INDENT DO PRINC TAB;
	PRINTSTR IDEA;
	FOR NEW PART IN GET(IDEA, 'IDEA) DO SHOW0(PART, INDENT+1);
	RETURN IDEA;
	END;

EXPR GET_INP(QUES, X);
	BEGIN
	NEW ANS, CHAN;
	CHAN ← OUTC(NIL, NIL);
	PRINTSTR(QUES CAT " ?");
	SHOW(X);
	OUTC(CHAN, NIL);
	ANS ← READ();
	RETURN(IF ANS EQ 'N THEN NIL ELSE ANS);
	END;

EXPR WARN(MES);
	BEGIN
	NEW CHAN;
	CHAN ← OUTC(NIL, NIL);
	PRINTSTR MES;
	OUTC(CHAN, NIL);
	RETURN NIL;
	END;

% Should make selection of TTY or DSK output better. %

EXPR TFDM(IDEA, MODE, FILE);
	BEGIN
	EVAL <'OUTPUT, '(390 RCP), (FILE CONS 'TRC)>;
	OUTC(T, NIL);
	ANS ← FDM(IDEA, MODE);
	OUTC(NIL, T);
	RETURN ANS;
	END;
% FDM COMBIN FDM1 FIND DIG MAKE %

EXPR FDM(IDEA, MODE);
	IF NUMBERP(IDEA) THEN NCONS READLIST('n CONS EXPLODE(IDEA))
	ELSE IF ATOM(IDEA) THEN NCONS IDEA
	ELSE FOR NEW ID IN COMBIN(IDEA, MODE) COLLECT FDM1(ID, MODE);

EXPR COMBIN(IDEA, MODE);
	IF ¬IDEA THEN '(NIL)
	ELSE FOR NEW ID IN COMBIN(CDR IDEA, MODE) COLLECT
		FOR NEW ATM IN FDM(CAR IDEA, MODE) COLLECT NCONS(ATM CONS ID);

% FDM1, FIND, DIG, & MAKE only work on a single level list of atoms. %

EXPR FDM1(IDEA, MODE);
	IF (TEMP ← FIND(IDEA)) THEN TEMP
	ELSE IF MODE EQ 'D THEN DIG(IDEA)
	ELSE IF MODE EQ 'M THEN MAKE(IDEA)
	ELSE NIL;

EXPR FIND(IDEA);
	BEGIN
	IF TRACING THEN PRINTSTR("Trying to FIND " CAT IDEA);
	RETURN(
	FOR NEW ATM IN IDEA	FOR NEW POS IN '(P1 P2 P3 P4 P5); INTERSECT
		GET(ATM, POS));
	END;
		
% Should be able to return multiple answers and extraneous information. %

EXPR DIG(IDEA);
	BEGIN
	NEW STACK;
	IF CDR IDEA MEMBER (STACK ← GET(CAR IDEA, 'STACK)) THEN
		RETURN WARN("Looking for " CAT IDEA CAT " again.")
	ELSE PUTPROP(CAR IDEA, CDR IDEA CONS STACK, 'STACK);
	TEMP ← IF CAR IDEA EQ 'TIME THEN APPLY(FUNCTION(TIMEX), IDEA)
		ELSE IF GET(CAR IDEA, 'EXPR) THEN APPLY(CAR IDEA, IDEA)
		ELSE NIL;
	PUTPROP(CAR IDEA, STACK, 'STACK);
	RETURN(IF TEMP THEN FDM(TEMP, 'M) ELSE NIL);
	END;

EXPR MAKE(IDEA);
	BEGIN
	NEW NAME;
	IF QM MEMQ IDEA THEN RETURN(WARN("Can't MAKE idea with " CAT QM));
	NAME ← IF ABBREV THEN ABBREV ELSE GENSYM();
	INTERN NAME;
	PUTPROP(NAME, IDEA, 'IDEA);
	FOR NEW ATM IN IDEA	FOR NEW POS IN '(P1 P2 P3 P4 P5) DO
		ADDPROP(ATM, NAME, POS);
	SHOW(NAME);
	RETURN NCONS NAME;
	END;
% GET_TIME TIMEP ASSUME %

% Should return multiple time qualifiers. %

EXPR GET_TIME(IDEA);
	IF ¬ATOM(IDEA) AND TIMEP(IDEA) THEN IDEA
	ELSE IF (IDEA ← FDM(<'TIME, IDEA, QM>, 'D)) THEN
		GET((GET(CAR IDEA, 'IDEA))[3], 'IDEA)
	ELSE NIL;

EXPR TIMEP(IDEA);
	CAR IDEA MEMQ '(YEAR SEASON MONTH WEEK DAY HOUR MINUTE);

EXPR ASSUME(IDEA);
	IF QM MEMQ IDEA THEN NIL ELSE IDEA;
% BEFORE CONCURRENT %

% Should establish common ground before seeking connection. %

EXPR BEFORE(FN, X, Y);
	BEGIN
	NEW TX, TY;
	IF (TX ← GET(X, 'IDEA)) THEN NIL ELSE TX ← GET(QM, 'IDEA);
	IF (TY ← GET(Y, 'IDEA)) THEN NIL ELSE TY ← GET(QM, 'IDEA);
	RETURN(
	IF X EQ Y THEN NIL
	ELSE IF (TEMP ← FDM1(<'CAUSE, X, Y>, 'D)) THEN
		<FN, (TEMP ← GET(CAR TEMP, 'IDEA))[2], TEMP[3]>
	ELSE IF (TX[1] EQ 'START OR X EQ QM) AND
		(TY[1] EQ 'STOP OR Y EQ QM) AND
		(TEMP ← FDM1(<'CONCURRENT, TX[2], TY[2]>, 'D)) THEN
<FN, <'START, (TEMP ← GET(CAR TEMP, 'IDEA))[2]>, <'STOP, TEMP[3]>>
	ELSE IF TX[1] EQ 'START AND TX[2] EQ Y OR
		TY[1] EQ 'STOP AND TY[2] EQ X THEN <FN, X, Y>
	ELSE IF TX[1] MEMQ '(START STOP) AND
		(TEMP ← FDM1(<FN, TX[2], Y>, 'D)) THEN
			<FN, X, (GET(CAR TEMP, 'IDEA))[3]>
	ELSE IF TY[1] MEMQ '(START STOP) AND
		(TEMP ← FDM1(<FN, X, TY[2]>, 'D)) THEN
			<FN, (GET(CAR TEMP, 'IDEA))[2], Y>
	ELSE IF QM MEMQ <X, Y> THEN NIL
	ELSE IF (TX ← GET_TIME(<'STOP, X>)) AND
		(TY ← GET_TIME(<'START, Y>)) AND
		(TX[3] ≤ TY[2] OR TY[3] ≤ TX[2]) THEN
			IF TX[3] ≤ TY[2] THEN <FN, X, Y> ELSE NIL
% Should work from both ends alternately instead of pushing one way first. %
	ELSE IF (TX ← FDM1(<FN, X, QM>, 'D)) AND
		(FOR NEW TZ IN TX DO
		TY ← FDM1(<FN, (GET(TZ, 'IDEA))[3], Y>, 'D)
		UNTIL TY) OR
		(TY ← FDM1(<FN, QM, Y>, 'D)) AND
		(FOR NEW TZ IN TY DO
		TX ← FDM1(<FN, X, (GET(TZ, 'IDEA))[2]>, 'D)
		UNTIL TX) THEN <FN, X, Y>
	ELSE NIL);
	END;

EXPR CONCURRENT(FN, X, Y);
	IF X EQ Y THEN <FN, X, Y>
	ELSE IF (TEMP ← FIND(<FN, Y, X>))
	OR (TEMP ← FDM1(<'INVOLVE, Y, X>, 'D)) THEN
		<FN, (TEMP ← GET(CAR TEMP, 'IDEA))[3], TEMP[2]>
	ELSE IF QM MEMQ <X, Y> THEN NIL
	ELSE IF FDM(<'BEFORE, <'START, X>, <'STOP, Y>>, 'D)
	AND FDM(<'BEFORE, <'START, Y>, <'STOP, X>>, 'D) THEN
		<FN, X, Y>
	ELSE NIL;
% DURATION INVOLVE KING START STOP %

% Should allow multiple time specifications. %
% Should take "n" off of numbers to subtract them. %

EXPR DURATION(FN, X, Y);
	BEGIN
	NEW TX, TY;
	RETURN(
	IF (TX ← GET_TIME(<'START, X>)) AND
	   (TY ← GET_TIME(<'STOP, X>)) THEN
		<FN, X, <'YEAR, TY[2]-TX[3], TY[3]-TX[2]+1>>
	ELSE IF ¬(TX ← GET(X, 'IDEA)) THEN NIL
	ELSE IF TX[1] EQ 'KING THEN
		IF TX[3] EQ 'US THEN <FN, X, '(YEAR 4 8)>
		ELSE <FN, X, '(YEAR 10 40)>
	ELSE IF TX[1] EQ 'WAR THEN <FN, X, '(YEAR 5 10)>
	ELSE NIL);
	END;

EXPR INVOLVE(FN, X, Y);
	IF (TEMP ← FIND(<FN, Y, X>)) THEN
		<FN, (TEMP ← GET(CAR TEMP, 'IDEA))[3], TEMP[2]>
	ELSE NIL;

EXPR KING(FN, X, Y);
	IF Y MEMQ <'US, QM> AND X MEMQ '(WASHINGTON ADAMS NIXON FORD) THEN
		<FN, X, 'US>
	ELSE NIL;

EXPR START(FN, X);
	IF (TEMP ← GET(X, 'IDEA)) AND TEMP[1] MEMQ '(START STOP) THEN
		WARN("Attempt to generate " CAT <FN, TEMP>) ALSO X
	ELSE ASSUME(<FN, X>);

EXPR STOP(FN, X);
	IF (TEMP ← GET(X, 'IDEA)) AND TEMP[1] MEMQ '(START STOP) THEN
		WARN("Attempt to generate " CAT <FN, TEMP>) ALSO X
	ELSE ASSUME(<FN, X>);
% TIMEX WAR YEAR %

% Should allow multiple time specifications. %
% Should take "n" off of numbers to subtract them. %

EXPR TIMEX(FN, X, Y);
	BEGIN
	NEW TX, TY;
	RETURN(
	IF (TX ← GET(X, 'IDEA)) AND TIMEP(TX) THEN <FN, X, X>
	ELSE IF (TX ← GET(X, 'IDEA)) AND TX[1] MEMQ '(START STOP) AND
		(TY ← GET_TIME(TX[2])) THEN
			IF (TEMP ← FDM1(<'DURATION, TX[2], QM>, 'D)) AND
			   (TEMP ← GET(CAR TEMP, 'IDEA)) AND
			   (TEMP ← GET(TEMP[3], 'IDEA)) THEN
				<FN, X, IF TX[1] EQ 'START
					THEN <'YEAR, TY[2], TY[3]-TEMP[2]>
					ELSE <'YEAR, TY[2]+TEMP[2], TY[3]>>
			ELSE <FN, X, TY>
	ELSE IF (TX ← GET_TIME(<'START, X>)) AND
		(TY ← GET_TIME(<'STOP, X>)) THEN
			<FN, X, <'YEAR, TX[2], TY[3]>>
	ELSE NIL);
	END;

EXPR WAR(FN, X, Y);
	IF (TEMP ← FIND(<FN, Y, X>)) THEN
		<FN, (TEMP ← GET(CAR TEMP, 'IDEA))[3], TEMP[2]>
	ELSE NIL;

EXPR YEAR(FN, X, Y);
	ASSUME(<FN, X, Y>);

EXPR SAMPLE;
	FDM('(CONCURRENT (KING ques FRANCE) CONSTITUTION), 'D);

GCGAG(T);
INIT_QM('ques);
READ_BOOK('BOOK);

END.